home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 02 - 1986 / 02.04 Apr 86.sit / 02.04 Apr 86 / Basic April 86 / HangMac (.txt) next >
Encoding:
AmigaBASIC Source Code  |  1986-03-20  |  7.6 KB  |  296 lines  |  [MSBC/MSBB]
  1. 'HANGMAC
  2. '©MACTUTOR, 1986
  3. 'by David Kelly
  4.  
  5.     Initialize:
  6.     CLEAR,20000
  7.     DEFINT a-z
  8.     DIM wordchar(1)
  9.     false=0:true=NOT false
  10.     talk=true:number=15
  11.     DIM wordarray$(number)
  12.     ON ERROR GOTO 10
  13.     LIBRARY "SpeechLib"
  14. 5 :ON ERROR GOTO 0
  15.     IF talk=true THEN GOSUB InitTalk
  16.     FOR i=1 TO number
  17.         READ wordarray$(i)
  18.     NEXT i
  19.     blank$=""
  20.     FOR i=1 TO 40:blank$=blank$+" ":NEXT i
  21.     WINDOW CLOSE 1
  22.     FOR i=1 TO 5
  23.         MENU i,0,0,""
  24.     NEXT i
  25.     
  26.     MENU 1,0,1,"File"
  27.     MENU 1,1,1,"Instructions"
  28.     MENU 1,2,1,"Start Game"
  29.     MENU 1,3,1,"Quit"
  30.     MENU 2,0,1,"Speech"
  31.     MENU 2,1,2,"ON"
  32.     MENU 2,2,1,"OFF"
  33.     IF talk=false THEN MENU 2,0,0
  34.     WrongGuess=10
  35.     GOSUB HangSetup
  36.     GOSUB DrawHangMac
  37.     ON MENU GOSUB menuevent
  38.     MENU ON
  39. idleloop: GOTO idleloop
  40.  
  41. menuevent:
  42.     menunumber=MENU(0):IF menunumber=2 THEN Speechmenu
  43.     menuitem=MENU(1):MENU
  44.     MENU 1,0,0
  45.     ON menuitem GOSUB Instructions,Start,Quit
  46.     RETURN
  47.  
  48. Speechmenu:
  49.     menuitem=MENU(1):MENU
  50.     IF menuitem=1 THEN MENU 2,1,2:MENU 2,2,1:talk=true
  51.     IF menuitem=2 THEN MENU 2,1,1:MENU 2,2,2:talk=false
  52.     MENU ON
  53.     RETURN
  54.     
  55. InitTalk:
  56.     SpeechHand!=0:SpeechErr%=0:Phon$=""
  57.     hertz%=190:mode%=0:Wpm%=125
  58.     SpeechOn! "",SpeechHand!,SpeechErr%
  59.     SpeechPitch! SpeechHand!,hertz%,mode%
  60.     SpeechRate! SpeechHand!,Wpm%
  61.     POKE &H208,5
  62.     RETURN
  63.     
  64. Quit:
  65.     GOSUB ClearKeyboard
  66.     IF talk=true THEN Eng$="Good buy.   Play again sometime.":GOSUB Speakup
  67.     IF talk=true THEN SpeechOff! SpeechHand!  :LIBRARY CLOSE
  68.     WINDOW CLOSE 1
  69.     WINDOW CLOSE 2
  70.     WINDOW CLOSE 3
  71.     MENU RESET
  72.     END
  73.     
  74. Start:
  75.     MENU ON
  76.     x!=FRE(1)
  77.     RANDOMIZE TIMER
  78.     index=INT(RND(1)*number)
  79.     IF index=0 THEN Start
  80.     word$=wordarray$(index)
  81.     GOSUB HangSetup
  82.     ERASE wordchar
  83.     DIM wordchar(LEN(word$))
  84.     FOR i=1 TO LEN(word$)
  85.         wordchar(i)=false
  86.     NEXT i
  87.     usedchar=0:used$=""
  88.     WrongGuess=0:lose=false
  89.     <0xd320441,0xd318010>(2)
  90.     <0xd32045e,0xd318010>(14)
  91.     <0xd32047c,0xd318010>(1)
  92.     wflag=false
  93.     sumword=0
  94.     GOSUB DisplayWord
  95.     IF talk=false THEN inputchar
  96.     Eng$="Your word is "+STR$(LEN(word$))+" characters long."
  97.     GOSUB Speakup
  98. inputchar:
  99.     WINDOW 1
  100.     GOSUB DrawHangPost
  101.     GOSUB ClearKeyboard
  102.     EDIT FIELD 1,"",(95,190)-(410,210),1,2
  103.     IF talk=false THEN charloop
  104.     Eng$="Please choose a letter"
  105.     GOSUB Speakup
  106. charloop:
  107.     d=<0x43,0xd318010>(0)
  108.     IF d<>6 THEN charloop
  109.     char$=UCASE$(EDIT$(1))
  110.     IF char$="" THEN inputchar
  111.     IF talk=false THEN checkchar
  112.     Eng$="You have selected, "+char$+".  "
  113.     IF char$<"A" OR char$>"Z" THEN Eng$=Eng$+"That character is not a loud."
  114.     IF INSTR(used$,char$)<>0 THEN Eng$=Eng$+"That letter is already used."
  115. Wrong:IF char$<>word$ AND LEN(char$)<>1 THEN Eng$=Eng$+"WRONGE!"
  116.     GOSUB Speakup
  117. checkchar:
  118.     IF char$<"A" OR char$ >"Z" THEN inputchar
  119.     IF INSTR(used$,char$)<>0 THEN inputchar
  120.     IF char$=word$ THEN GOSUB foundword
  121.     IF char$<>word$ AND LEN(char$)<>1 THEN WrongGuess=WrongGuess+1:GOSUB DrawHangMac :GOTO inputchar
  122.     used$=used$+char$+" "
  123.     oldsum=sumword
  124.     sumword=0
  125.     FOR i=1 TO LEN(word$)
  126.         IF char$=MID$(word$,i,1) THEN wordchar(i)=true
  127.         sumword=wordchar(i)+sumword
  128.     NEXT i
  129.     Eng$="That's "
  130.     IF oldsum=sumword THEN WrongGuess=WrongGuess+1:Eng$=Eng$+"WRONG!"
  131.     IF sumword=-LEN(word$) THEN wflag=true
  132.     IF (wflag=false) AND (oldsum<>sumword) THEN Eng$=Eng$+"Right.   There is at least one "+char$+" in the word."
  133.     IF wflag=true THEN Eng$=Eng$+"Right.  You have guessed the word."
  134.     IF talk=true THEN GOSUB Speakup
  135.     GOSUB DisplayUsedChars
  136.     GOSUB DrawHangMac
  137.     GOSUB DisplayWord
  138.     IF wflag=false AND lose=false THEN inputchar
  139.     IF wflag=true THEN Eng$="You Won.  The word is "+word$+".  Select Start Game to Play again."
  140.     IF lose=true THEN Eng$="You're dead.  The word is "+word$+".  Select Start Game to Play again."
  141.     IF talk=true THEN GOSUB Speakup
  142.     FOR i=1 TO LEN(word$)
  143.         wordchar(i)=true
  144.     NEXT i
  145.     WINDOW 1
  146.     EDIT FIELD CLOSE 1
  147.     MENU 1,0,1
  148.     RETURN
  149.  
  150. HangSetup:
  151.     WINDOW 1,"HangMac",(10,100)-(500,320),2
  152.     <0xd31fcd5,0xd318010>(2):<0x14,0x07>(18):<0x14,0x02>(1)
  153.     LOCATE 1,1:PRINT "HangMac"
  154.     <0xd31fd30,0xd318010>(10):<0x0e,0x02>(0)
  155.     PRINT " Copyright ©MacTutor, 1986"
  156.     PRINT" by David Kelly."
  157.     WINDOW 2,"",(95,30)-(410,45),2
  158.     WINDOW 3,"",(95,65)-(410,80),2
  159.     WINDOW 1
  160.     RETURN
  161.  
  162. foundword:
  163.     wflag=true
  164.     FOR i=1 TO LEN(word$)
  165.         wordchar(i)=true
  166.     NEXT i
  167.     RETURN
  168.  
  169. DisplayWord:
  170.     WINDOW 3
  171.     LOCATE 1,1
  172.     PRINT blank$:LOCATE 1,1
  173.     IF lose=true THEN PRINT word$;:RETURN
  174.     FOR j=1 TO LEN(word$)
  175.         IF wordchar(j)=true THEN PRINT MID$(word$,j,1); :ELSE PRINT "_ ";
  176.     NEXT j
  177.     RETURN
  178.     
  179. DisplayUsedChars:
  180.     IF LEN(char$)>1 THEN RETURN
  181.     WINDOW 2
  182.     LOCATE 1,1
  183.     PRINT used$;
  184.     RETURN
  185.     
  186. DrawHangMac:
  187.     WINDOW 1
  188.     GOSUB DrawHangPost
  189.     IF WrongGuess >=1 THEN CIRCLE(250,35),25
  190.     IF WrongGuess >=2 THEN CIRCLE(260,25),5
  191.     IF WrongGuess >=3 THEN CIRCLE(240,25),5
  192.     IF WrongGuess >=4 THEN LINE(240,45)-(260,45)
  193.     CALL <0x0b,0xd318010>(2,2)
  194.     CALL <0x0d,0xd318010>(250,60)
  195.     IF WrongGuess >=5 THEN CALL <0x19,0xd318010>(250,125)
  196.     IF WrongGuess >=6 THEN CALL LINE(45,45)
  197.     IF WrongGuess >=7 THEN CALL <0x25,0xd318010>(250,125):CALL LINE(-45,45)
  198.     IF WrongGuess >=8 THEN CALL <0x25,0xd318010>(250,90):CALL LINE(25,-25)
  199.     IF WrongGuess >=9 THEN CALL <0x26,0xd318010>(250,90):CALL LINE(-25,-25)
  200.     CALL <0x06,0xd318010>
  201.     IF WrongGuess >=9 THEN CALL <0x3c,0xd318010>(255,20):CALL LINE(10,10):CALL <0x3c,0x02>(255,30):CALL LINE(10,-10)
  202.     IF WrongGuess >=9 THEN CALL <0x3c,0xd318010>(235,20):CALL LINE(10,10):CALL <0x3c,0x02>(235,30):CALL LINE(10,-10)
  203.     IF WrongGuess >=9 THEN lose=true
  204.     RETURN
  205.     
  206. DrawHangPost:
  207.     CALL <0x0b,0xd318010>(4,4)
  208.     CALL <0x0c,0xd318010>(250,5)
  209.     CALL <0x0d,0xd318010>(310,5)
  210.     CALL <0x0e,0xd318010>(310,185)
  211.     RETURN
  212.     
  213. ClearKeyboard:
  214.     key$="X"
  215.     WHILE key$ <>""
  216.         key$=INKEY$
  217.     WEND
  218.     RETURN
  219.  
  220. 10 :IF ERR=53 THEN talk=false
  221.     RESUME 5
  222.     END
  223.     
  224. Instructions:
  225.     WINDOW CLOSE 2
  226.     WINDOW CLOSE 3
  227.     WINDOW 1,"Instructions",(10,30)-(500,330),-2
  228.     <0xd320502,0xd318010>(2):<0x14,0x07>(18):<0x14,0x02>(1)
  229.     LOCATE 1,15:PRINT "HangMac"
  230.     <0xd32055e,0xd318010>(12):<0x0e,0x02>(0)
  231.     LOCATE 3,1:PRINT "HangMac is the audio version of the traditional game of";
  232.     PRINT" Hangman.  To play":PRINT"the game just choose ";
  233.     <0xd320617,0xd318010>(0):PRINT"Start Game";:<0x1c,0x07>(2)
  234.     PRINT" from the File menu.   The hanging post is"
  235.     PRINT "drawn and you may start guessing letters by typing them onto the base of"
  236.     PRINT"the hanging post.  The uppermost window will display the characters which"
  237.     PRINT"you have used.  The next window shows the characters, or blanks for the"
  238.     PRINT"word that you are guessing.  Each time you miss, a new part of the HangMac"
  239.     PRINT"man will be drawn until the entire body is drawn.  If you guess wrong ten"
  240.     PRINT"times then you lose.  Type the whole word to guess the word."
  241.     PRINT"This program features CLR SpeechLib procedures for calling Macintalk."
  242.     PRINT"To use the speech feature you must have CLR SpeechLib (available from"
  243.     PRINT"Clear Lake Research, 5353 Dora Street, Suite 7, Houston, Texas 77005"
  244.     PRINT"(800-835-2246 X 199).  However, the program will still work without"
  245.     PRINT"the speech libraries being available."
  246.     PRINT:PRINT"HangMac, Copyright ©MacTutor, 1986, by David Kelly."
  247.     <0x40,0xd318010> 1,1,"OK",(445,260)-(475,290)
  248.     IF talk=true THEN <0x40,0xd318010> 2,1,"TALK",(365,260)-(425,290)
  249. WaitforButton:
  250.     WHILE <0x43,0xd318010>(0)<>1:WEND
  251.     buttonpushed = <0x43,0xd318010>(1)
  252.     IF buttonpushed=2 THEN GOSUB SpeakInstructions:GOTO WaitforButton
  253.     <0x40,0xd318010> CLOSE 1
  254.     <0x40,0xd318010> CLOSE 2
  255.     WINDOW CLOSE 1
  256.     MENU 1,0,1
  257.     RETURN
  258.     
  259. SpeakInstructions:
  260.     <0x40,0xd318010> 1,0:<0x40,0x07> 2,0
  261.     Eng$=" HangMac is the audio version of the traditional game of Hangman.  To play"
  262.     Eng$=Eng$+" the game just choose Start Game from the File menu.   The hanging post is"
  263.     Eng$=Eng$+" drawn and  you may start guessing letters by typing them onto the base of"
  264.     Eng$=Eng$+" the hanging post.  The uppermost wyndoe will display the charactors which"
  265.     Eng$=Eng$+" you have used.  The next wyndoe shows the characters, or blanks for the"
  266.     Eng$=Eng$+" word that you are guessing.  Each time you miss, a new part of the HangMac"
  267.     Eng$=Eng$+"-man will be drawn until the entire body is drawn.  If you guess wrong ten"
  268.     Eng$=Eng$+" times then you luse. Type the whole word to guess the word."
  269.     ReaderString! SpeechHand!,Eng$,Phon$,SpeechErr%
  270.     SoundOutString! SpeechHand!,Phon$,SpeechErr%
  271.     Eng$="This program features CLR SpeechLib proseedures for calling Macintalk."
  272.     Eng$=Eng$+" To use the speech feature you must have CLR SpeechLib (available from"
  273.     Eng$=Eng$+" Clear Lake Reserch, 5353 Dora Street, sweet 7, Huse ton, Texas 77005."
  274.     Eng$=Eng$+" phone- eight hundred 835-2246 extension199.  However, the program will still work without the speech lybraries"
  275.     Eng$=Eng$+" being available."
  276.     Eng$=Eng$+" HangMac, Copy right MacTutor, nineteen eighty six, by Dayvid Kelly."
  277.     ReaderString! SpeechHand!,Eng$,Phon$,SpeechErr%
  278.     SoundOutString! SpeechHand!,Phon$,SpeechErr%
  279.     Eng$="":Phon$=""
  280.     <0x40,0xd318010> 1,1:<0x40,0x07> 2,1
  281.     RETURN
  282. Speakup:
  283.     ReaderString! SpeechHand!, Eng$,Phon$,SpeechErr%
  284.     SoundOutString! SpeechHand!,Phon$,SpeechErr%
  285.     RETURN
  286.     
  287. 'Add additional words (as you please)
  288. 'by adding to the DATA statements below
  289. 'change the variable 'number' at the beginning
  290. 'of the program to reflect the number of words
  291. 'available.
  292.  
  293. DATA "MACINTOSH","MOUSE","DISK","DESKTOP","CURSOR"
  294. DATA "ICON","KEYBOARD","WINDOW","MENU","PRINTER"
  295. DATA "MODEM","BYTE","MEMORY","PROGRAM","DATA"
  296.